unit DEnvyControls;

interface

uses
	Windows, Messages, SysUtils, Classes, Controls, Graphics, StdCtrls, Forms;

type
	TDEControlType = (ctEditBox,ctEllipseBox,ctComboBox);

	TDETextBox = class(TCustomControl)
	private
		fBtnDown: boolean;
		fText: string;
		fFont: TFont;
		fItems: TStringList;
		fItemIndex: integer;
		fEdit: THandle;
		fControlType: TDEControlType;
		fHasBorder: boolean;
		fReadOnly: boolean;
		fOnEllipseClick: TNotifyEvent;
		fOnDropDown: TNotifyEvent;
		fOnChange: TNotifyEvent;
		pOldListWndProc: pointer;
		pOldEditWndProc: pointer;
		fListInstance: pointer;
		fEditInstance: pointer;
		hList: THandle;
		fDropped: boolean;
		procedure SetFont(const Value: TFont);
		procedure SetItems(const Value: TStringList);
		procedure SetItemIndex(const Value: integer);
		procedure SetControlType(const Value: TDEControlType);
		procedure SetHasBorder(const Value: boolean);
		procedure SetReadOnly(const Value: boolean);
		function GetText: string;
		procedure SetText(const Value: string);
	protected
		procedure wmSize(var msg: TWMSize); message WM_SIZE;
		procedure wmCtlColorEdit(var msg: TWMCtlColorEdit); message WM_CTLCOLOREDIT;
		procedure wmCtlColorStatic(var msg: TWMCtlColorStatic); message WM_CTLCOLORSTATIC;
		procedure wmLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
		procedure wmLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
		procedure wmMouseMove(var msg: TWMMouseMove); message WM_MOUSEMOVE;
		procedure wmCommand(var msg: TWMCommand); message WM_COMMAND;
		procedure ListWndProc(var msg: TMessage);
		procedure EditWndProc(var msg: TMessage);
		procedure ShowDropDownList;
	public
		constructor Create(aOwner: TComponent); override;
		destructor Destroy; override;
		procedure Paint; override;
		procedure CreateWnd; override;
		procedure WndProc(var msg: TMessage); override;
		procedure SelectText(nStart, nEnd: integer);
	published
		property Font: TFont read fFont write SetFont;
		property Items: TStringList read fItems write SetItems;
		property ItemIndex: integer read fItemIndex write SetItemIndex;
		property ControlType: TDEControlType read fControlType write SetControlType;
		property HasBorder: boolean read fHasBorder write SetHasBorder;
		property ReadOnly: boolean read fReadOnly write SetReadOnly;
		property OnEllipseClick: TNotifyEvent read fOnEllipseClick write fOnEllipseClick;
		property OnDropDown: TNotifyEvent read fOnDropDown write fOnDropDown;
		property OnChange: TNotifyEvent read fOnChange write fOnChange;
		property OnDblClick;
		property Text: string read GetText write SetText;
		property TabOrder;
		property TabStop;
	end;

procedure Register;

implementation

procedure Register;
begin
	RegisterComponents('Standard', [TDETextBox]);
end;

{ TDEComboBox }

constructor TDETextBox.Create(aOwner: TComponent);
begin
	inherited Create(aOwner);
	fFont := TFont.Create;
	with fFont do begin
		Size := 8;
		Name := 'Tahoma';
		Color := clWindowText;
	end;
	fItems := TStringList.Create;
	fItemIndex := -1;
	fReadOnly := false;
	Width := 120;
	Height := 15;
	fHasBorder := true;
	ControlStyle := [csCaptureMouse,csClickEvents,csSetCaption,csOpaque,csReflector];
	fBtnDown := false;
	fOnEllipseClick := nil;
	fListInstance := MakeObjectInstance(ListWndProc);
	fEditInstance := MakeObjectInstance(EditWndProc);
	fDropped := false;
	TabStop := true;
end;

procedure TDETextBox.CreateWnd;
var
	rc: tRect;
begin
	inherited CreateWnd;
	if (csDesigning in ComponentState) then exit;
	rc := ClientRect;
	if fHasBorder then
		InflateRect(rc,-1,-1);
	if fControlType <> ctEditBox then
		dec(rc.Right,15);
	fEdit := CreateWindow('EDIT',nil,WS_CHILD or WS_VISIBLE or ES_AUTOHSCROLL,
		rc.Left,rc.Top,rc.Right-rc.Left,rc.Bottom-rc.Top,Handle,0,hInstance,nil);
	pOldEditWndProc := pointer(GetWindowLong(fEdit,GWL_WNDPROC));
	SetWindowLong(fEdit,GWL_WNDPROC,integer(fEditInstance));
	SendMessage(fEdit,WM_SETFONT,fFont.Handle,1);
	SetReadOnly(fReadOnly);
	SetText(fText);
end;

destructor TDETextBox.Destroy;
begin
	fFont.Free;
	fItems.Free;
  FreeObjectInstance(fEditInstance);
	FreeObjectInstance(fListInstance);
	inherited Destroy;
end;

procedure TDETextBox.Paint;
var
	rc: TRect;
	i,j: integer;
	s: string;
begin
	with Canvas do begin
		rc := ClientRect;
		if fHasBorder then
			DrawEdge(Handle,rc,BDR_SUNKENOUTER,BF_RECT or BF_ADJUST);
		if fControlType <> ctEditBox then begin
			i := rc.Left;
			rc.Left := rc.Right-15;
			Brush.Color := clBtnFace;
			FillRect(rc);
			if fBtnDown then
				DrawEdge(Handle,rc,BDR_SUNKENOUTER,BF_RECT)
			else
				DrawEdge(Handle,rc,BDR_RAISEDINNER,BF_RECT);
			Pen.Color := clBtnText;
			if fControlType = ctEllipseBox then begin
				for j := 0 to 2 do begin
					MoveTo(rc.Left+4+j*3,ClientHeight div 2 - 1);
					LineTo(rc.Left+4+j*3,ClientHeight div 2 + 2);
				end;
			end else begin
				for j := 0 to 3 do begin
					MoveTo(rc.Left+7-j,(ClientHeight-1) div 2 + 2 - j);
					LineTo(rc.Left+8+j,(ClientHeight-1) div 2 + 2 - j);
				end;
			end;
			rc.Left := i;
			dec(rc.Right,15);
		end;
		if fReadOnly then
			Brush.Color := clBtnFace
		else
			Brush.Color := clWindow;
		FillRect(rc);
		Font.Assign(fFont);
		s := GetText;
		if s <> '' then begin
			InflateRect(rc,-3,0);
			if fReadOnly then
				Font.Color := clBtnFace
			else
				Font.Color := clWindowText;
			DrawText(Handle,pChar(s),Length(s),rc,DT_LEFT or DT_TOP);
		end;
	end;
end;

procedure TDETextBox.SetControlType(const Value: TDEControlType);
var
	msg: TWMSize;
begin
	fControlType := Value;
	wmSize(msg);
	Invalidate;
end;

procedure TDETextBox.SetReadOnly(const Value: boolean);
begin
	fReadOnly := Value;
	SendMessage(fEdit,EM_SETREADONLY,WPARAM(fReadOnly),0);
	Invalidate;
end;

procedure TDETextBox.SetFont(const Value: TFont);
begin
	fFont.Assign(Value);
	SendMessage(fEdit,WM_SETFONT,fFont.Handle,1);
	Invalidate;
end;

procedure TDETextBox.SetHasBorder(const Value: boolean);
begin
	fHasBorder := Value;
	Invalidate;
end;

procedure TDETextBox.SetItemIndex(const Value: integer);
begin
	fItemIndex := Value;
	if fItemIndex < 0 then fItemIndex := -1;
	if fItemIndex >= fItems.Count then fItemIndex := fItems.Count-1;
	if fItemIndex >= 0 then
		SetText(pChar(fItems.Strings[fItemIndex]));
	Invalidate;
end;

procedure TDETextBox.SetItems(const Value: tStringList);
begin
	fItems.Assign(Value);
	if (fItems.Count > 0) then begin
		if (fItemIndex = -1) then
			ItemIndex := 0
	end else
		ItemIndex := -1;
	Invalidate;
end;

procedure TDETextBox.wmCtlColorEdit(var msg: TWMCtlColorEdit);
begin
	msg.Result := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
	SetTextColor(msg.ChildDC,GetSysColor(COLOR_WINDOWTEXT));
	SetBkColor(msg.ChildDC,GetSysColor(COLOR_WINDOW));
end;

procedure TDETextBox.wmCtlColorStatic(var msg: TWMCtlColorStatic);
begin
	msg.Result := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
	SetTextColor(msg.ChildDC,GetSysColor(COLOR_BTNTEXT));
	SetBkColor(msg.ChildDC,GetSysColor(COLOR_BTNFACE));
end;

procedure TDETextBox.wmSize(var msg: TWMSize);
var
	rc: TRect;
begin
	rc := ClientRect;
	if fControlType <> ctEditBox then
		dec(rc.Right,15);
	if fHasBorder then
		InflateRect(rc,-1,-1);
	MoveWindow(fEdit,rc.Left,rc.Top,rc.Right-rc.Left,rc.Bottom-rc.Top,TRUE);
end;

procedure TDETextBox.wmLButtonDown(var msg: TWMLButtonDown);
var
	rc: TRect;
begin
	Windows.SetFocus(fEdit);
	if fDropped or (fControlType = ctEditBox) then exit;
	rc := ClientRect;
	if fHasBorder then
		InflateRect(rc,-1,-1);
	rc.Left := rc.Right-15;
	if PtInRect(rc,Point(msg.XPos,msg.YPos)) then begin
		fBtnDown := true;
		SetCapture(Handle);
		Invalidate;
	end;
end;

procedure TDETextBox.wmLButtonUp(var msg: TWMLButtonUp);
begin
	if GetCapture = Handle then begin
		ReleaseCapture;
		if fBtnDown then begin
			if (fControlType = ctEllipseBox) then begin
				fBtnDown := false;
				Invalidate;
				if Assigned(fOnEllipseClick) then
					fOnEllipseClick(self);
			end else if fControlType = ctComboBox then begin
				ShowDropDownList;
			end;
		end;
	end;
end;

procedure TDETextBox.wmMouseMove(var msg: TWMMouseMove);
var
	rc: TRect;
	bOldBtnDown: boolean;
begin
	if (fControlType = ctEditBox) or fDropped or (GetCapture <> Handle) then exit;
	rc := ClientRect;
	if fHasBorder then
		InflateRect(rc,-1,-1);
	rc.Left := rc.Right-15;
	bOldBtnDown := fBtnDown;
	if PtInRect(rc,Point(msg.XPos,msg.YPos)) then
		fBtnDown := true
	else
		fBtnDown := false;
	if bOldBtnDown <> fBtnDown then
		Invalidate;
end;

procedure TDETextBox.wmCommand(var msg: TWMCommand);
begin
	if (msg.NotifyCode = EN_CHANGE) and Assigned(fOnChange) then
		fOnChange(self);
end;

function TDETextBox.GetText: string;
var
	buf: array[0..1024] of char;
begin
	if csDesigning in ComponentState then
		Result := fText
	else begin
		GetWindowText(fEdit,buf,1025);
		Result := buf;
	end;
end;

procedure TDETextBox.SetText(const Value: string);
begin
	if csDesigning in ComponentState then
		fText := Value
	else
		SetWindowText(fEdit,pChar(Copy(Value,1,1024)));
	Invalidate;
end;

procedure TDETextBox.ListWndProc(var msg: TMessage);
var
	i: integer;
	pt: TPoint;
	rc,rc2: TRect;
begin
	with msg do begin
		case Msg of
			WM_TIMER: if (GetAsyncKeyState(VK_LBUTTON) < 0) or
					(GetAsyncKeyState(VK_MBUTTON) < 0) or
					(GetAsyncKeyState(VK_RBUTTON) < 0) then begin
				Windows.GetWindowRect(hList,rc);
				GetCursorPos(pt);
				if not PtInRect(rc,pt) then begin
					fDropped := false;
					fBtnDown := false;
					DestroyWindow(hList);
					Invalidate;
					exit;
				end;
			end;
			WM_LBUTTONUP: begin
				Windows.GetWindowRect(hList,rc);
				MapWindowPoints(HWND_DESKTOP,hList,rc,2);
				Windows.GetClientRect(hList,rc2);
				if PtInRect(rc2,Point(LOWORD(LParam),HIWORD(LParam))) or
						not PtInRect(rc,Point(LOWORD(LParam),HIWORD(LParam))) then begin
					i := SendMessage(hList,LB_GETCURSEL,0,0);
					if i <> LB_ERR then
						ItemIndex := i
					else
						ItemIndex := -1;
					fDropped := false;
					fBtnDown := false;
					DestroyWindow(hList);
					exit;
				end;
			end;
			WM_COMMAND: if HIWORD(WParam) = LBN_SELCHANGE then begin
				i := SendMessage(hList,LB_GETCURSEL,0,0);
				if i <> LB_ERR then
					ItemIndex := i
				else
					ItemIndex := -1;
				fDropped := false;
				fBtnDown := false;
				DestroyWindow(hList);
				exit;
			end;
			WM_KEYDOWN: if (WParam = VK_RETURN) or (WParam = VK_ESCAPE) then begin
				if (WParam = VK_RETURN) then begin
					i := SendMessage(hList,LB_GETCURSEL,0,0);
					if i <> LB_ERR then
						ItemIndex := i
					else
						ItemIndex := -1;
				end;
				fDropped := false;
				fBtnDown := false;
				DestroyWindow(hList);
				Invalidate;
				exit;
			end;
		end;
		Result := CallWindowProc(pOldListWndProc,hList,Msg,WParam,LParam);
	end;
end;

procedure TDETextBox.WndProc(var msg: TMessage);
begin
	with msg do begin
		case Msg of
			WM_SETFOCUS: begin
				Windows.SetFocus(fEdit);
				Result := 0;
				exit;
			end;
			WM_KEYDOWN,WM_KEYUP: if fDropped then begin
				PostMessage(hList,WM_KEYDOWN,WParam,LParam);
				Result := 0;
				exit;
			end;
		end;
	end;
	inherited WndProc(msg);
end;

procedure TDETextBox.EditWndProc(var msg: TMessage);
begin
	with msg do begin
		case Msg of
			WM_LBUTTONDBLCLK: if Assigned(OnDblClick) then OnDblClick(self);
			WM_CHAR: if fDropped or (GetAsyncKeyState(VK_CONTROL) < 0) then begin
				Result := 0;
				exit;
			end;
			WM_KEYDOWN,WM_KEYUP: if fDropped then begin
				PostMessage(hList,Msg,WParam,LParam);
				Result := 0;
				exit;
			end else if WParam = VK_TAB then begin
				PostMessage(self.Handle,Msg,VK_TAB,LParam);
				Result := 0;
				exit;
			end else if (WParam = VK_SPACE) and (GetAsyncKeyState(VK_CONTROL) < 0) then begin
				if (fControlType = ctComboBox) then begin
					fBtnDown := false;
					Invalidate;
					ShowDropDownList;
				end else if (fControlType = ctEllipseBox) and Assigned(fOnEllipseClick) then
					fOnEllipseClick(self);
				Result := 0;
				exit;
			end;
		end;
		Result := CallWindowProc(pOldEditWndProc,fEdit,Msg,WParam,LParam);
	end;
end;

procedure TDETextBox.ShowDropDownList;
var
	rc: TRect;
	i,ih: integer;
begin
	if Assigned(fOnDropDown) then
		fOnDropDown(self);
	rc := ClientRect;
	MapWindowPoints(Handle,0,rc,2);
	hList := CreateWindowEx(WS_EX_TOOLWINDOW,'LISTBOX',nil,
		WS_CHILD or WS_BORDER or WS_VSCROLL or LBS_HASSTRINGS or LBS_NOTIFY,
		rc.Left,rc.Bottom,Width,100,GetDesktopWindow(),0,hInstance,nil);
	pOldListWndProc := pointer(GetWindowLong(hList,GWL_WNDPROC));
	SetWindowLong(hList,GWL_WNDPROC,integer(fListInstance));
	SendMessage(hList,WM_SETFONT,fFont.Handle,0);
	ih := SendMessage(hList,LB_GETITEMHEIGHT,0,0);
	for i := 0 to fItems.Count-1 do
		SendMessage(hList,LB_ADDSTRING,0,LPARAM(pChar(fItems.Strings[i])));
	if fItems.Count > 10 then
		ih := ih*10
	else
		ih := ih*fItems.Count;
	SendMessage(hList,LB_SETCURSEL,fItemIndex,0);
	SetWindowPos(hList,HWND_TOP,0,0,Width,ih+4,SWP_NOMOVE or SWP_SHOWWINDOW);
	SendMessage(hList,WM_SETFOCUS,0,0);
	SendMessage(hList,WM_ACTIVATE,WA_CLICKACTIVE,0);
	fDropped := true;
	SetTimer(hList,666,10,nil);
end;

procedure TDETextBox.SelectText(nStart, nEnd: integer);
begin
  SendMessage(fEdit,EM_SETSEL,nStart,nEnd);
end;

end.

